;<134-TENEX>MR.MAC;2    24-Jun-79 19:53:31    EDIT BY PETERS
;<TENEX-132>MR.MAC;4    10-NOV-73 17:33:31	EDIT BY CLEMENTS
;<TENEX-130>MR.MAC;3     2-NOV-72 13:34:57	EDIT BY TOMLINSON
;8 JUN 71, 1225:
;D. MURPHY

	TITLE RITH		;DOUBLE PRECISION ARITHMETIC FOR TENEX
	SEARCH	STENEX,PROLOG

	INTERN EDFAD.,EDFMP.,EDFDV.,EDFSB.,GETEXP,PUTEXP

	IFNDEF MONFLG,<MONFLG==1>
AOP1==0
AOP2==1
BKSTK=16


;AC ASSIGNMENTS

A=12		;AC FOR OPERAND AND RESULT. AND A+1.
B=14		;=A+2.
C=15
M=10		;MEMORY OPERAND POINTER AND TEMP. M+1 ALSO USED.
P=17		;CONTROL PUSHDOWN


;ABBREVIATED PDP-10 OP CODES

	OPDEF CALL [PUSHJ P,]
	OPDEF RET [POPJ P,]

;THE MORE GENERAL ROUTINES.
;SLOWER IN REGULAR CASE CAUSE MUST STORE AC OPERAND FOR
;RETRY ON OVERLOW.
;AC OPERAND AND ANSWER IN A&A+1, MOVE POINTS TO MEMORY OPERAND.

;EDFAD IS EXTENDED RANGE DOUBLE PRECISION ADD
;FORMAT OF NUMBER IS STANDARD FOR BINARY EXPONENT WITHIN RANGE
;MAGNITUDE LESS THAN 128 OR DECIMAL EXP<=38 (ABOUT)
;EXTENDED RANGE NUMBERS HAVE SECOND WORD WITH MINUS SIGN BIT
;8 BITS OF EXPONENT ARE HIGH ORDER EXTENSION OF EXPONENT
;ALL EXPONENTS ARE STILL EXCESS 128
;ROUTINE IS CALLED WITH ONE NUMBER IN A,A+1
;OTHER IN 0(M),1(M)   ... CALLED WITH
;       MOVEI M,LOC		; WHERE MEMORY LOC IS GIVEN

	PUSHJ P,EDFAD.
;ANSWER LEFTIN A,A+1   OTHER AC'S GENERALLY CLOBBERED



EDFAD.:	PUSH P,BKSTK
	HRRI BKSTK,1(P)
	ADD P,[XWD 2,2]
	IFG MONFLG,<
	EXTERN MSTKOV
	JUMPGE P,MSTKOV>
	MOVEM A,AOP1(BKSTK)		;SAVE AC OPS
	MOVEM A+1,AOP2(BKSTK)
	JFOV .+1		;MAY NOT REALLY BE NEEDED
	SKIPGE M+1,1(M)		;TEST FOR EITHER OPERAND EXT RANGE. FREELOAD.
	JRST .EXRNG
	JUMPL A+1,.EXRNG
DFAD:	UFA A+1,M+1		;STANDARD DP ADD SEE P 2-67 OF SYSTEM MANUAL
	FADL A,0(M)
	UFA A+1,A+2
	FADL A,A+2
	JFOV ADSAVE
	SUB P,[XWD 2,2]
	POP P,BKSTK
	POPJ P,

ADSAVE:	MOVE A,AOP1(BKSTK)
	MOVE A+1,AOP2(BKSTK)		;RESTORE AC OPS
		;JRST .EXRNG		;.EXRNG IS NEXT



;EXTENDED RANGE ADD:
;RETURN LARGER IF EXPONENTS DIFFER BY TOO MUCH,
;ELSE SHIFT EXPONENTS INTO RANGE, ADD, SHIFT BACK

.EXRNG:	MOVE M,(M)		;M!
EXRNG:	PUSH P,C
	PUSHJ P,GETEXP		;GETS EXP OF A INTO B
	MOVE C,B
	EXCH A,M		;PUT MEMORY NUM IN A
	EXCH A+1,M+1
	PUSHJ P,GETEXP		;OTHER EXPONENT
	CAML B,C		;COMPARE WITH FIRST EXP
	JRST RTORD		;RIGHT ORDER IF LARGER IS IN A
	EXCH A,M
	EXCH A+1,M+1		;EXCHANGE BRINGING LARGER NUM TO A
	EXCH B,C		;EXCHANGE EXPONENTS TOO

RTORD:	SUB B,C		;DIFF OF EXPS
	CAILE B,^D54		;A>>M
	JRST REXRNG		;ANSWER IS IN A
	PUSH P,C		;SAVE ORIGINAL LOWEST EXP
	MOVEI C,^D128		;HIGH ORDER EXP FOR M
	SKIPGE M		;IS MOVE NEGATIVE
	SETCA C,		;YES, SO COMPLEMENT EXP
	DPB C,[POINT 8,M,8]		;INSERT EXP
	MOVEI C,^D101		;LOW ORDER EXP
	DPB C,[POINT 9,M+1,8]
	ADD C, B
	DPB C,[POINT 9,A+1,8]
	ADDI C,^D27		;HIGH ORDER EXP FOR A
	SKIPGE A
	SETCA C,		;IF A NEG COMPLEMENT EXP
	DPB C,[POINT 8,A,8]
	UFA A+1,M+1		;STD DP ADD
	FADL A,M		;..
	UFA A+1,A+2		;..
	FADL A,A+2		;..
	POP P,C		;ORIGINAL EXP
	JUMPE A,REXRNG		;IF ANSWER IS ZERO
	PUSHJ P, GETEXP		;GET EXP IN B
	ADD B,C		;ADD EXPONENT TO GET RESULT
	SUBI B,^D128		;SUBTRACT EXCESS EXCESS 200
	PUSHJ P,PUTEXP		;PUT IT IN NUMBER
REXRNG:	POP P,C
	SUB P,[XWD 2,2]
	POP P,BKSTK
	POPJ P,



;GETEXP  EXPECTS NUMBER IN A,A+1  AND RETURNS EXPONENT IN B

GETEXP:	JUMPE A,EXP0		;TEST FOR ZERO NUMBER
	LDB B,[POINT 8,A,8]
	JUMPGE A,.+2
	XORI B,377		;IF  LOW ORDER EXP FROM A  SHOULD BE NEGATED DO SO
	JUMPGE A+1,GEND		;IF NOT IN EXTENDED RANGE THEN DONE
	LSH B,^D20		;PUT NEXT TO POSITION FOR HIGH ORDER BITS
	ROT A+1,^D9		;PUT EXP IN RIGHT HAND PART OF AC
	DPB A+1,[POINT 8,B,7]
	ROT A+1,-^D9
	ASH B,-^D20
GEND:	POPJ P,

EXP0:	MOVNI B,77777		;FOR ZERO RETURN SMALLEST POSSIBLE EXPONENT
	RET



;PUTEXP EXPECTS NUMBER IN A,A+1 AND EXP IN B RETURN RESULT IN A,A+1
;PUTS EXPONENT INTO NUMBER , KNOWING ABOUT EXTENDED RANGE

PUTEXP:	JUMPE A,PXEND		;ZERO HAS ITS OWN EXP
	DPB B,[POINT 8,A,8]
	CAIGE B,400		;IS NUMBER INSIDE RANGE
	CAIGE B,33
	JRST PEXT		;NO
	MOVEI B,-33(B)		;LO EXPONENT = HI-^D27. LO SIGN BIT=0
PXDPB:	DPB B,[POINT 9,A+1,8]		;DEPOSIT LOW ORDER EXP AND SIGN BIT
	JUMPGE A,.+2
	TLC A,377000		;ONES COMPL EXPON IF NEG
PXEND:	POPJ P,

PEXT:	CAILE B,715		;UPPER LIMIT SHD BE TWICE OFFICIAL FOR COMPARISONS
	JFCL		;NUMBER >10^99 CANT HAPPEN, CHECK JRB
	CAMGE B,[-310]
	JFCL		;NUMBER <10^-99 CANT HAPPEN, CHECK JRB
	ASH B,-10
	TRO B,400		;LOW SIGN BIT = 1 TO FLAG EXTENDED RANGE NUMBER
	JRST PXDPB		;NOW DEPOSIT  EXP EXTENSION


;SB IS SAME AS EDFSB  JUST COMPLEMENTS TWICE AND ADDS

EDFSB.:	DFN A,A+1		;NEGATE FIRST OPERAND
	PUSHJ P,EDFAD.
	DFN A,A+1
	POPJ P,		;-(M-A)=A-M




;EDFDV IS ALMOST IDENTICAL TO EDFMP AND IS GIVEN FIRST
;THE TWO SETS OF INSTRUCTIONS AT MDINS AND ASINS MAKE THE DIFFERENCE

MDINS:	PUSHJ P,DFMPX		;ORDINARY DP MULT
	PUSHJ P,DFDVX		;ORDINARY DP QUOTIENT

ASINS:	ADDM B,0(P)		;ADD EXPS FOR MULT
	SUBM B,0(P)		;SUBTRACT EXPS FOR DIVIDE


EDFDV.:	PUSH P,BKSTK
	HRRI BKSTK,1(P)
	ADD P,[XWD 2,2]
	IFG MONFLG,<
	JUMPGE P,MSTKOV>
	MOVEM A,AOP1(BKSTK)		;SAVE AC OPS
	MOVEM A+1,AOP2(BKSTK)
	JFCL 17,.+1		;CLEAR FOV FLAG
	MOVE M+1,1(M)		;MUST LOAD MEM OPERAND NOW SO CAN SHARE
	MOVE M,(M)		;..."DFDV" CODE W X RNG CASE
	JUMPL A+1,QEXT		;USUAL CHECK FOR OUT OF RANGE
	JUMPL M+1,QEXT		;..

DFDV:	FDVL A,M		;STANDARD ROUTINE P2-68
	MOVN B,A
	FMPR B,M+1
	UFA A+1,B
	FDVR B,M
	FADL A,B
	JFOV DVSAVE
	SUB P,[XWD 2,2]
	POP P,BKSTK
	POPJ P,

DVSAVE:	JFCL 17,.+1		;CLEAR OV FLAGS
	MOVE A,AOP1(BKSTK)	;RESTORE AC OPERANDS
	MOVE A+1,AOP2(BKSTK)
QEXT:	PUSH P,C		;SAVE C
	MOVEI C,1		;USED TO INDEX MDINS,ASINS
	JRST MQEXT		;COMMON ROUTINE FOR MULT AND DIV
DFMPX:	PUSH P,BKSTK
	ADD P,[XWD 2,2]
	IFG MONFLG,<
	JUMPGE P,MSTKOV>
	JRST DFMP
DFDVX:	PUSH P,BKSTK
	ADD P,[XWD 2,2]
	IFG MONFLG,<
	JUMPGE P,MSTKOV>
	JRST DFDV


;EDFMP DOES DP MULTIPLICATION,USES MQEXT TO DO WORK

EDFMP.:	PUSH P,BKSTK
	HRRI BKSTK,1(P)
	ADD P,[XWD 2,2]
	IFG MONFLG,<
	JUMPGE P,MSTKOV>
	MOVEM A,AOP1(BKSTK)		;SAVE AC OPS
	MOVEM A+1,AOP2(BKSTK)
	MOVE M+1,1(M)		;LOAD MEMORY OPERAND (SO DFMP CODE CAN BE
	MOVE M,(M)		;...SHARED WITH X RANGE CASE)
	JFOV .+1
	JUMPL A+1,MEXT		;CHECK FOR EXTENDED RANGE OPERANDS
	JUMPL M+1,MEXT		;...

DFMP:	MOVEM A,B		;ORDINARY DP MUL SEE P2-67
	FMPR B,M+1
	FMPR A+1,M
	UFA A+1,B
	FMPL A,M
	UFA A+1,B
	FADL A,B
	JFOV MPSAVE
	SUB P,[XWD 2,2]
	POP P,BKSTK
	POPJ P,


MPSAVE:	MOVE A,AOP1(BKSTK)
	MOVE A+1,AOP2(BKSTK)		;RESTORE AC ARGS

;USE EXTENDED MULTIPLY

MEXT:	PUSH P,C		;SAVE C
	MOVEI C,0		;USED TO INDEX ASINS MDINS 0 FOR MUL 1 FOR DIV
		;JRST MQEXT		;MQEXT IS NEXT


;MQEXT DOES HEART OF WORK FOR EXTENDED RANGE MUL AND DIV
;IS JUMPED TO BY BOTH  0 IN CALL FOR MUL, 1 IN CALL FOR DIV


MQEXT:	PUSHJ P,GETEXP		;EXPONENT OF A
	PUSH P,B		;SAVE IT
	MOVEI B,^D128		;STANDARD EXP FOR MUL AND IDV
	PUSHJ P,PUTEXP		;PUT EXP IN A
	EXCH A,M
	EXCH A+1,M+1
	PUSHJ P,GETEXP		;GET OTHER EXPONENT

	EXCH B,0(P)
	XCT ASINS(C)		;ADD OR SUBTRACT TO MEMORY

	MOVEI B,^D128
	PUSHJ P,PUTEXP
	EXCH A,M		;PUT FIRST ARG IN A
	EXCH A+1,M+1
	XCT MDINS(C)		;EITHER MULTIPLY OR DIVIDE
	PUSHJ P,GETEXP		;GET RESULTING EXP
	ADD B,0(P)
	SKIPN C		;SKIP IF DIVIDE
	SUB B,[^D256]		;SUBTRACT TWO EXCESS 128S
	PUSHJ P,PUTEXP		;STORE RESULTING EXPONENT
	POP P,B
	POP P,C		;FIRST POP WAS ONLY TO GET RID OF JUNK
	SUB P,[XWD 2,2]
	POP P,BKSTK
	POPJ P,



	END